home *** CD-ROM | disk | FTP | other *** search
Option Explicit Option Base 1 ' Type Declarations Type RECT Left As Integer Top As Integer right As Integer bottom As Integer End Type Type MovieEntry MovieName As String MovieDesc As String PicHandle As Integer End Type ' Global Constants Global Const DEFAULT_LIST = "vbrowser.lst" Global Const NUMTHUMBNAILS = 4 ' Global Data Global FirstOffset As Integer Global IgnoreClick As Integer Global NumberMovies As Integer Global MovieList() As MovieEntry ' Function Declarations in external DLL'S Declare Sub InvertRect Lib "User" (ByVal hDC As Integer, lpRect As RECT) Declare Sub VBDisposePicture Lib "QTMovie.VBX" (ByVal phPicture As Integer) Declare Function VBDrawPicture Lib "QTMovie.VBX" (ByVal hDC As Integer, ByVal phThePict As Integer, lprcFrame As RECT, ByVal pprpProgressProc As Long) As Long Declare Function VBGetMoviePosterPict Lib "QTMovie.VBX" (ByVal mMovie As Long) As Integer Sub DrawPanel (fra As Control) ' Draw two 3-D rectangles around the frame Const DARK_GRAY = &H808080 Const WHITE = &HFFFFFF Dim rc As RECT Dim xFactor As Integer Dim yFactor As Integer xFactor = Screen.TwipsPerPixelX yFactor = Screen.TwipsPerPixelY ' Draw inner frame; left and top lines are dark gray, right and bottom ' are white rc.Left = fra.Left - 1 * xFactor rc.Top = fra.Top - 1 * yFactor rc.right = fra.Left + fra.Width + 1 * xFactor rc.bottom = fra.Top + fra.Height + 1 * yFactor VBrowser.Line (rc.Left, rc.Top)-(rc.right - 1, rc.Top), DARK_GRAY VBrowser.Line (rc.Left, rc.Top)-(rc.Left, rc.bottom - 1), DARK_GRAY VBrowser.Line (rc.right, rc.Top)-(rc.right, rc.bottom), WHITE VBrowser.Line (rc.Left, rc.bottom)-(rc.right, rc.bottom), WHITE ' Draw outer frame; left and top lines are white, right and bottom are ' dark gray rc.Left = fra.Left - 4 * xFactor rc.Top = fra.Top - 4 * yFactor rc.right = fra.Left + fra.Width + 4 * xFactor rc.bottom = fra.Top + fra.Height + 4 * yFactor VBrowser.Line (rc.Left, rc.Top)-(rc.right, rc.Top), WHITE VBrowser.Line (rc.Left, rc.Top)-(rc.Left, rc.bottom), WHITE VBrowser.Line (rc.right, rc.Top + 1)-(rc.right, rc.bottom), DARK_GRAY VBrowser.Line (rc.Left + 1, rc.bottom)-(rc.right, rc.bottom), DARK_GRAY End Sub Function GetThumbNails () As Integer ' Read the browser list file; save the movie names and poster picture ' handles Dim MovieDesc As String Dim MovieListFile As Integer Dim MovieListName As String Dim MovieLine As String Dim MovieName As String Dim posDesc As Integer ' Establish an error handler On Error GoTo HandleThumbError ' Get a file handle and establish the browser list file name; if none is ' given on the command line, use the default file name MovieListFile = FreeFile If Len(Command$) = 0 Then MovieListName = DEFAULT_LIST Else MovieListName = Command$ End If ' Open the browser list file; this file contains the list of movie file ' names to use; each line contains a fully qualified movie file name and ' an optional description Open MovieListName For Input As MovieListFile ' Read the browser list file and store the movie name and associated ' poster picture handle into the MovieList array Do Line Input #MovieListFile, MovieLine posDesc = InStr(MovieLine, " ") If posDesc > 0 Then MovieName = LCase$(Left$(MovieLine, posDesc - 1)) Do posDesc = posDesc + 1 Loop While posDesc <= Len(MovieLine) And Mid$(MovieLine, posDesc, 1) = " " MovieDesc = Mid$(MovieLine, posDesc) Else MovieName = LCase$(MovieLine) MovieDesc = MovieName End If NumberMovies = NumberMovies + 1 ReDim Preserve MovieList(NumberMovies) As MovieEntry MovieList(NumberMovies).MovieName = MovieName MovieList(NumberMovies).MovieDesc = MovieDesc VBrowser!QTMovie.MovieName = MovieName MovieList(NumberMovies).PicHandle = VBGetMoviePosterPict(VBrowser!QTMovie.Movie) Loop While Not EOF(MovieListFile) Close MovieListFile ' Display the movie poster frames as thumbnail bitmaps ShowThumbNails ' All done GetThumbNails = True Exit Function HandleThumbError: ' Something went wrong; format an error message, set the error return and ' exit Title!cmdOK.Visible = True Title!lblMessage.Caption = "Error: " & Error(Err) DoEvents GetThumbNails = False Exit Function End Function Sub InvertPicture (pic As Control) ' Use the Windows InvertRect function to invert the pixels in a thumbnail Dim rcPic As RECT rcPic.Left = 0 rcPic.Top = 0 rcPic.right = pic.ScaleWidth * Screen.TwipsPerPixelX rcPic.bottom = pic.ScaleHeight * Screen.TwipsPerPixelY InvertRect pic.hDC, rcPic End Sub Sub Main () ' This is the main routine; first, show the title form and load the ' VBrowser form (don't make the VBrowser form visible yet) Title.Show DoEvents Load VBrowser ' Set some global data; we've got no movies so far and the first thumbnail's ' offset is zero FirstOffset = 0 NumberMovies = 0 ' Set the movie's poster width and height to that of the thumbnail client VBrowser!QTMovie.PosterWidth = VBrowser!picThumbNail(1).ScaleWidth VBrowser!QTMovie.PosterHeight = VBrowser!picThumbNail(1).ScaleHeight ' Read the browser list file and display the thumbnail bitmaps; if all ' went OK, unload the Title form and show the first movie If GetThumbNails() Then Unload Title ShowMovie 1 End If End Sub Function max (iFirst As Integer, iSecond As Integer) As Integer ' Determine the maximum integer If iFirst > iSecond Then max = iFirst Else max = iSecond End If End Function Function min (iFirst As Integer, iSecond As Integer) As Integer ' Determine the minimum integer If iFirst < iSecond Then min = iFirst Else min = iSecond End If End Function Sub ShowMovie (MovieIndex As Integer) ' Position the VBrowser controls to be consistent with the movie size and ' resize the VBrowser form ' These constants aid in the spatial layout of the individual controls Const OFFSET_THUMBNAIL = 540 Const OFFSET_FILENAME = 300 Const OFFSET_FORMHEIGHT = 720 ' Set the movie name from the MovieList; set the form's caption to the ' movie description VBrowser!QTMovie.MovieName = MovieList(MovieIndex).MovieName VBrowser.Caption = MovieList(MovieIndex).MovieDesc ' Size the frame to fit tightly around the movie; center the frame VBrowser!fraMovie.Width = VBrowser!QTMovie.Width VBrowser!fraMovie.Height = VBrowser!QTMovie.Height VBrowser!fraMovie.Left = (VBrowser.ScaleWidth - VBrowser!fraMovie.Width) / 2 ' Reposition the thumbnail frame VBrowser!fraThumbNail.Top = VBrowser!fraMovie.Top + VBrowser!fraMovie.Height + OFFSET_THUMBNAIL ' Reposition the left and right thumbnail scroll buttons VBrowser!imgButtonLeft.Top = VBrowser!fraThumbNail.Top + (VBrowser!fraThumbNail.Height - VBrowser!imgButtonLeft.Height) / 2 VBrowser!imgButtonRight.Top = VBrowser!imgButtonLeft.Top ' Reposition the file name label control VBrowser!lblFileName.Top = VBrowser!fraThumbNail.Top - OFFSET_FILENAME ' Resize the VBrowser form and center it on the screen VBrowser.Height = VBrowser!fraThumbNail.Top + VBrowser!fraThumbNail.Height + OFFSET_FORMHEIGHT VBrowser.Left = (Screen.Width - VBrowser.Width) / 2 VBrowser.Top = (Screen.Height - VBrowser.Height) / 2 VBrowser.Refresh ' Let the audience see what we have VBrowser.Show End Sub Sub ShowThumbNails () ' Display the thumbnail bitmaps Dim i As Integer Dim VisibleNew As Integer ' Force each thumbnail picture to be repainted For i = 1 To NUMTHUMBNAILS VBrowser!picThumbNail(i).Refresh DoEvents Next i ' Make the thumbnail scroll buttons visible or invisible as needed; only ' change the visibility property if it has changed VisibleNew = (FirstOffset >= 1) If VisibleNew <> VBrowser!imgButtonLeft.Visible Then VBrowser!imgButtonLeft.Visible = VisibleNew End If VisibleNew = ((FirstOffset + NUMTHUMBNAILS) <= NumberMovies) If VisibleNew <> VBrowser!imgButtonRight.Visible Then VBrowser!imgButtonRight.Visible = VisibleNew End If End Sub 
